home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / t_rex10 / trexdm01.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  4KB  |  143 lines
  1. unit Trexdm01;
  2.  
  3. {
  4. $Log:   W:/users/prodigy/prodig~1/archive/trex/trexdm01.pav  $
  5.  * 
  6.  *    Rev 1.1   07 Apr 1996 18:30:52   PaulK
  7.  * Work in progress on demos
  8. }
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, Buttons, StdCtrls, ExtCtrls, T_Rex, Gauges;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     Rex1: TRex;
  19.     OpenDialog1: TOpenDialog;
  20.     Label1: TLabel;
  21.     Bevel1: TBevel;
  22.     Button1: TButton;
  23.     Button2: TButton;
  24.     BitBtn1: TBitBtn;
  25.     Bevel2: TBevel;
  26.     Label2: TLabel;
  27.     Label3: TLabel;
  28.     Gauge1: TGauge;
  29.     Label4: TLabel;
  30.     procedure Button1Click(Sender: TObject);
  31.     procedure Button2Click(Sender: TObject);
  32.     procedure Rex1EOF(Sender: TObject);
  33.     procedure Rex1Match(Sender: TObject; const Expression: Word;
  34.       const Token: String; const InputLine: PChar; const Offset,
  35.       Length: Word);
  36.     procedure Rex1AfterLineMatch(Sender: TObject);
  37.     procedure Rex1BeforeLineMatch(Sender: TObject);
  38.     procedure Rex1BOF(Sender: TObject);
  39.   private
  40.     { Private declarations }
  41.     CommentCount: word; {counts the number of comment-only lines}
  42.     InComment: boolean; {true while we are in a multi-line comment}
  43.   public
  44.     { Public declarations }
  45.   end;
  46.  
  47. var
  48.   Form1: TForm1;
  49.  
  50. implementation
  51.  
  52. {$R *.DFM}
  53.  
  54. procedure TForm1.Button1Click(Sender: TObject);
  55. begin
  56. if OpenDialog1.Execute then
  57.   begin
  58.   Rex1.FileSpec := OpenDialog1.Filename;
  59.   Button2.Enabled := true;
  60.   end
  61. else
  62.   Button2.Enabled := false;
  63.  
  64. end;
  65.  
  66. procedure TForm1.Button2Click(Sender: TObject);
  67. begin
  68. Screen.Cursor := crHourglass;
  69. Rex1.Scan;
  70. Screen.Cursor := crDefault;
  71. end;
  72.  
  73. procedure TForm1.Rex1EOF(Sender: TObject);
  74. begin
  75. Gauge1.Progress := Gauge1.MaxValue;
  76. With Rex1 do
  77.   Label2.Caption :=
  78.   Format('The file %s contains %d lines of which %d consist entirely of comments. Proportion of comment lines is %5.2f%%.',
  79.   [Filename, ScanLineNumber, CommentCount, CommentCount/ScanlineNumber*100.0]);
  80. end;
  81.  
  82. procedure TForm1.Rex1Match(Sender: TObject; const Expression: Word;
  83.   const Token: String; const InputLine: PChar; const Offset, Length: Word);
  84. begin
  85. case expression of
  86. 0: {first expression, comment begins and ends on the same line}
  87.    begin
  88.    inc(CommentCount);
  89.    Rex1.SeekEoln; {skip further processing of this line}
  90.    end;
  91. 1: {Comment begins on this line}
  92.    begin
  93.    InComment := true;
  94.    inc(CommentCount);
  95.    Rex1.SeekEoln; {skip further processing of this line}
  96.    end;
  97. 2: {Comment begins on this line, but there's some non-comment stuff before it}
  98.    begin
  99.    InComment := true;
  100.    Rex1.SeekEoln {skip further processing}
  101.    end;
  102. 3: {Comment ends on this line, with only spaces after}
  103.    begin
  104.    if InComment then {it didn't start on this line, so}
  105.      inc(CommentCount);
  106.    InComment := false;
  107.    Rex1.SeekEoln {skip further processing}
  108.    end;
  109. 4: {Comment ends on this line, but there's some non-comment stuff}
  110.    begin
  111.    InComment := false;
  112.    end;
  113.  
  114.    end; {case}
  115. end;
  116.  
  117. procedure TForm1.Rex1AfterLineMatch(Sender: TObject);
  118. {
  119. This gets called only if the OnMatch event didn't do a SeekEoln.
  120. It increments the counter in the interior of a multi-line comment.
  121. The first and last lines are counted in OnMatch, not here.
  122. }
  123. begin
  124. if InComment then
  125.   inc(CommentCount);
  126. end;
  127.  
  128. procedure TForm1.Rex1BeforeLineMatch(Sender: TObject);
  129. begin
  130. Label2.Caption := Format('Scanning %s  line %4d',[Rex1.Filename,Rex1.ScanLineNumber]);
  131. Label2.Refresh;
  132. Gauge1.Progress := Rex1.FilePosition;
  133. end;
  134.  
  135. procedure TForm1.Rex1BOF(Sender: TObject);
  136. begin
  137. InComment := false;
  138. CommentCount := 0;
  139. Gauge1.MaxValue := Rex1.Filesize;
  140. end;
  141.  
  142. end.
  143.